home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / pcl_src.zoo / defsys.lsp < prev    next >
Lisp/Scheme  |  1993-02-07  |  36KB  |  898 lines
  1. ;;;-*-Mode:LISP; Package:(PCL LISP ); Base:10; Syntax:Common-lisp -*-
  2. ;;;
  3. ;;; *************************************************************************
  4. ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Use and copying of this software and preparation of derivative works
  8. ;;; based upon this software are permitted.  Any distribution of this
  9. ;;; software or derivative works must comply with all applicable United
  10. ;;; States export control laws.
  11. ;;; 
  12. ;;; This software is made available AS IS, and Xerox Corporation makes no
  13. ;;; warranty about the software, its performance or its conformity to any
  14. ;;; specification.
  15. ;;; 
  16. ;;; Any person obtaining a copy of this software is requested to send their
  17. ;;; name and post office or electronic mail address to:
  18. ;;;   CommonLoops Coordinator
  19. ;;;   Xerox PARC
  20. ;;;   3333 Coyote Hill Rd.
  21. ;;;   Palo Alto, CA 94304
  22. ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
  23. ;;;
  24. ;;; Suggestions, comments and requests for improvements are also welcome.
  25. ;;; *************************************************************************
  26. ;;;
  27. ;;; Some support stuff for compiling and loading PCL.  It would be nice if
  28. ;;; there was some portable make-system we could all agree to share for a
  29. ;;; while.  At least until people really get databases and stuff.
  30. ;;;
  31. ;;; ***                                                               ***
  32. ;;; ***        DIRECTIONS FOR INSTALLING PCL AT YOUR SITE             ***
  33. ;;; ***                                                               ***
  34. ;;;
  35. ;;; To get PCL working at your site you should:
  36. ;;; 
  37. ;;;  - Get all the PCL source files from Xerox.  The complete list of source
  38. ;;;    file names can be found in the defsystem for PCL which appears towards
  39. ;;;    the end of this file.
  40. ;;; 
  41. ;;;  - Edit the variable *pcl-directory* below to specify the directory at
  42. ;;;    your site where the pcl sources and binaries will be.  This variable
  43. ;;;    can be found by searching from this point for the string "***" in
  44. ;;;    this file.
  45. ;;; 
  46. ;;;  - Use the function (pcl::compile-pcl) to compile PCL for your site.
  47. ;;; 
  48. ;;;  - Once PCL has been compiled it can be loaded with (pcl::load-pcl).
  49. ;;;    Note that PCL cannot be loaded on top of itself, nor can it be
  50. ;;;    loaded into the same world it was compiled in.
  51. ;;;
  52.  
  53. #+pcl
  54. (when (boundp 'pcl::*boot-state*)
  55.   (warn "Lisp heap already had PCL package.  Renaming it to OLD-PCL.")
  56.   (rename-package "PCL" "OLD-PCL"))
  57.  
  58. (in-package "PCL" :use (list (or (find-package :walker)
  59.                  (make-package :walker :use '(:lisp)))
  60.                  (or (find-package :iterate)
  61.                  (make-package :iterate
  62.                            :use '(:lisp :walker)))
  63.                  (find-package :lisp)))
  64.  
  65. (export (intern (symbol-name :iterate)        ;Have to do this here,
  66.         (find-package :iterate))    ;because in the defsystem
  67.     (find-package :iterate))        ;(later in this file)
  68.                         ;we use the symbol iterate
  69.                         ;to name the file
  70.  
  71. ;;;
  72. ;;; Sure, its weird for this to be here, but in order to follow the rules
  73. ;;; about order of export and all that stuff, we can't put it in PKG before
  74. ;;; we want to use it.
  75. ;;; 
  76. (defvar *the-pcl-package* (find-package :pcl))
  77.  
  78. (defvar *pcl-system-date* "July 92 PCL (1b)")
  79.  
  80. #+cmu
  81. (when (boundp 'ext::*herald-items*)
  82.   (setf (getf ext::*herald-items* :pcl)
  83.         `("    CLOS based on PCL version:  " ,*pcl-system-date*)))
  84.  
  85. ;;;
  86. ;;; Various hacks to get people's *features* into better shape.
  87. ;;; 
  88. (eval-when (compile load eval)
  89.   
  90.   #+(and Symbolics Lispm)
  91.   (multiple-value-bind (major minor) (sct:get-release-version)
  92.     (etypecase minor
  93.       (integer)
  94.       (string (setf minor (parse-integer minor :junk-allowed t))))
  95.     (pushnew :genera *features*)
  96.     (ecase major
  97.       ((6)
  98.        (pushnew :genera-release-6 *features*))
  99.       ((7)
  100.        (pushnew :genera-release-7 *features*)
  101.        (ecase minor
  102.      ((0 1) (pushnew :genera-release-7-1 *features*))
  103.      ((2)   (pushnew :genera-release-7-2  *features*))
  104.      ((3)   (pushnew :genera-release-7-3  *features*))
  105.      ((4)   (pushnew :genera-release-7-4  *features*))))
  106.       ((8)
  107.        (pushnew :genera-release-8 *features*)
  108.        (ecase minor
  109.      ((0) (pushnew :genera-release-8-0 *features*))
  110.      ((1) (pushnew :genera-release-8-1 *features*))))))
  111.   
  112.   #+CLOE-Runtime
  113.   (let ((version (lisp-implementation-version)))
  114.     (when (string-equal version "2.0" :end1 (min 3 (length version)))
  115.       (pushnew :cloe-release-2 *features*)))
  116.  
  117.   (dolist (feature *features*)
  118.     (when (and (symbolp feature)                ;3600!!
  119.                (equal (symbol-name feature) "CMU"))
  120.       (pushnew :CMU *features*)))
  121.   
  122.   #+TI
  123.   (if (eq (si:local-binary-file-type) :xld)
  124.       (pushnew ':ti-release-3 *features*)
  125.       (pushnew ':ti-release-2 *features*))
  126.  
  127.   #+Lucid
  128.   (when (search "IBM RT PC" (machine-type))
  129.     (pushnew :ibm-rt-pc *features*))
  130.  
  131.   #+ExCL
  132.   (cond ((search "sun3" (lisp-implementation-version))
  133.      (push :sun3 *features*))
  134.     ((search "sun4" (lisp-implementation-version))
  135.      (push :sun4 *features*)))
  136.  
  137.   #+(and HP Lucid)
  138.   (push :HP-Lucid *features*)
  139.   #+(and HP (not Lucid) (not excl))
  140.   (push :HP-HPLabs *features*)
  141.  
  142.   #+Xerox
  143.   (case il:makesysname
  144.     (:lyric (push :Xerox-Lyric *features*))
  145.     (otherwise (push :Xerox-Medley *features*)))
  146. ;;;
  147. ;;; For KCL and IBCL, push the symbol :turbo-closure on the list *features*
  148. ;;; if you have installed turbo-closure patch.  See the file kcl-mods.text
  149. ;;; for details.
  150. ;;;
  151. ;;; The xkcl version of KCL has this fixed already.
  152. ;;; 
  153.  
  154.   #+xkcl(pushnew :turbo-closure *features*)
  155.  
  156.   )
  157.  
  158.  
  159.  
  160. ;;; Yet Another Sort Of General System Facility and friends.
  161. ;;;
  162. ;;; The entry points are defsystem and operate-on-system.  defsystem is used
  163. ;;; to define a new system and the files with their load/compile constraints.
  164. ;;; Operate-on-system is used to operate on a system defined that has been
  165. ;;; defined by defsystem.  For example:
  166. #||
  167.  
  168. (defsystem my-very-own-system
  169.        "/usr/myname/lisp/"
  170.   ((classes   (precom)           ()                ())
  171.    (methods   (precom classes)   (classes)         ())
  172.    (precom    ()                 (classes methods) (classes methods))))
  173.  
  174. This defsystem should be read as follows:
  175.  
  176. * Define a system named MY-VERY-OWN-SYSTEM, the sources and binaries
  177.   should be in the directory "/usr/me/lisp/".  There are three files
  178.   in the system, there are named classes, methods and precom.  (The
  179.   extension the filenames have depends on the lisp you are running in.)
  180.   
  181. * For the first file, classes, the (precom) in the line means that
  182.   the file precom should be loaded before this file is loaded.  The
  183.   first () means that no other files need to be loaded before this
  184.   file is compiled.  The second () means that changes in other files
  185.   don't force this file to be recompiled.
  186.  
  187. * For the second file, methods, the (precom classes) means that both
  188.   of the files precom and classes must be loaded before this file
  189.   can be loaded.  The (classes) means that the file classes must be
  190.   loaded before this file can be compiled.  The () means that changes
  191.   in other files don't force this file to be recompiled.
  192.  
  193. * For the third file, precom, the first () means that no other files
  194.   need to be loaded before this file is loaded.  The first use of
  195.   (classes methods)  means that both classes and methods must be
  196.   loaded before this file can be compiled.  The second use of (classes
  197.   methods) mean that whenever either classes or methods changes precom
  198.   must be recompiled.
  199.  
  200. Then you can compile your system with:
  201.  
  202.  (operate-on-system 'my-very-own-system :compile)
  203.  
  204. and load your system with:
  205.  
  206.  (operate-on-system 'my-very-own-system :load)
  207.  
  208. ||#
  209.  
  210. ;;; 
  211. (defvar *system-directory*)
  212.  
  213. ;;;
  214. ;;; *port* is a list of symbols (in the PCL package) which represent the
  215. ;;; Common Lisp in which we are now running.  Many of the facilities in
  216. ;;; defsys use the value of *port* rather than #+ and #- to conditionalize
  217. ;;; the way they work.
  218. ;;; 
  219. (defvar *port*
  220.         '(#+Genera               Genera
  221. ;